unit Unit18;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, masks, ActnList, Menus;

type
  TForm18 = class(TForm)
    Memo1: TMemo;
    Panel1: TPanel;
    btnStart: TButton;
    btnEnd: TButton;
    Splitter1: TSplitter;
    Memo2: TMemo;
    edPath: TEdit;
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    edPattern: TEdit;
    cbxPatternType: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    MainMenu1: TMainMenu;
    Options1: TMenuItem;
    Hiddenfolders1: TMenuItem;
    ActionList1: TActionList;
    actHiddenFolders: TAction;
    actCopyAllToClipboard: TAction;
    actCopyAllToClipboard1: TMenuItem;
    procedure btnStartClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure btnEndClick(Sender: TObject);
    procedure actCopyAllToClipboardExecute(Sender: TObject);
    procedure actHiddenFoldersExecute(Sender: TObject);
  private
    FLastTime: cardinal;
    procedure Recurse(const Path: string);
    procedure AnalyseFile(const FileName: string);
    procedure ShowProgress;
    function Check(s: string): boolean;
    { Private declarations }
  public
    { Public declarations }
    dirCount, jarCount: integer;
    broken: boolean;
    fileBeingProcessed: string;
    mask: TMask;
    pattern: string;
    patternType: integer;
    destructor Destroy; override;
  end;

var
  Form18: TForm18;

implementation

uses KAZip, FileCtrl, clipbrd;

{$R *.dfm}

procedure TForm18.actCopyAllToClipboardExecute(Sender: TObject);
begin
  Clipboard.AsText := Memo1.Lines.Text;
end;

procedure TForm18.actHiddenFoldersExecute(Sender: TObject);
begin
  //
end;

procedure TForm18.AnalyseFile(const FileName: string);
var kz: TKAZip;
    i: integer;
    b: boolean;
    s: string;
begin
  b := false;
  kz := TKAZip.Create(nil);
  try
    kz.Open(FileName);
    for i := 0 to kz.FileNames.Count - 1 do begin
      s := kz.FileNames[i];
      if CompareText(copy(s, length(s)-6+1, MaxInt), '.class') = 0 then begin
        s := StringReplace(copy(s, 1, length(s)-6), '\', '.', [rfReplaceAll]);
        //if CompareText(copy(kz.FileNames[i], length(kz.FileNames[i]) - length(pattern) + 1, MaxInt), pattern) = 0 then begin
        if Check(s) then begin
          if not b then begin
            Memo1.Lines.Add(FileName);
            b := true;
          end;
          Memo1.Lines.Add(#9 + s);
        end;
      end;
    end;
    if b then Memo1.Lines.Add('');
  finally
    kz.Free;
  end;
end;

procedure TForm18.Recurse(const Path: string);
var sr: TSearchRec;
    s: string;
begin
  if SysUtils.FindFirst(Path + '*', faAnyFile, sr) = 0 then begin
    try
      repeat
        if (sr.Attr and faDirectory) <> 0 then begin
          if sr.name[1] <> '.' then begin
            if ((sr.Attr and faHidden) <> 0)
            and not actHiddenFolders.Checked then continue;
            s := Path + sr.Name + '\';
            fileBeingProcessed := s;
            ShowProgress;
            Recurse(s);
            inc(dirCount);
            fileBeingProcessed := '';
          end;
        end else begin
          if CompareText(copy(sr.name, length(sr.name)-4 + 1, MaxInt), '.jar') = 0 then begin
            fileBeingProcessed := Path + sr.Name;
            try
              ShowProgress;
              AnalyseFile(fileBeingProcessed);
              inc(jarCount);
            except
              on EAbort do raise;
              on E: Exception do begin
                Memo2.Lines.Append(E.Message);
              end;
            end;
            fileBeingProcessed := '';
          end;
        end;
      until SysUtils.FindNext(sr) <> 0;
    finally
      SysUtils.FindClose(sr);
    end;
  end;
end;

procedure TForm18.ShowProgress;
var t: cardinal;
begin
  t := GetTickCount;
  if t - FLastTime > 100 then begin
    FLastTime := t;
    edPath.Text := fileBeingProcessed;
    Application.ProcessMessages;
    if broken or Application.Terminated then Abort;
  end;
end;

procedure TForm18.btnEndClick(Sender: TObject);
begin
  broken := true;
end;

procedure TForm18.btnStartClick(Sender: TObject);
var dir, dir2: string;
begin
  FreeAndNil(mask);
  pattern := trim(edPattern.Text);
  patternType := cbxPatternType.ItemIndex;
  if patternType in [1, 3] then pattern := UpperCase(pattern);
  if patternType = 4 then mask := TMask.Create(edPattern.Text);
  Memo1.Clear;
  Memo2.Clear;
  dir := edPath.Text;
  dir2 := dir;
  if (length(dir2) = 0)or(dir[length(dir2)]<> '\') then dir2 := dir2 + '\';
  try
    dirCount := 0;
    jarCount := 0;
    cbxPatternType.Enabled := false;
    btnStart.Enabled := false;
    btnEnd.Enabled := true;
    edPath.ReadOnly := true;
    edPattern.ReadOnly := true;
    broken := false;
    try
      try
        Recurse(dir2);
      finally
        Memo2.Lines.Add('Dirs processed = ' + IntToStr(dirCount));
        Memo2.Lines.Add('Jars processed = ' + IntToStr(jarCount));
      end;
    except
      on E: Exception do begin
        Memo2.Lines.Append(E.Message);
      end;
    end;
  finally
    cbxPatternType.Enabled := true;
    edPattern.ReadOnly := false;
    edPath.Text := dir;
    edPath.ReadOnly := false;
    btnStart.Enabled := true;
    btnEnd.Enabled := false;
  end;
end;

procedure TForm18.Button1Click(Sender: TObject);
var s: string;
begin
  s := edPath.Text;
  if SelectDirectory('Select Directory', ExtractFileDrive(s), s, [sdNewUI, sdNewFolder]) then begin
    edPath.Text := s;
  end;
end;

function TForm18.Check(s: string): boolean;
var n, pl: integer;
begin
  Result := false;
  if patternType in [1, 3] then s := UpperCase(s);
{
Ends with (case)
Ends with (No case)
Contains (case)
Contains (No case)
Mask (*, ?, No case)
}
  case patternType of
    0, 1: begin
      pl := length(pattern);
      Result :=  pl = 0;
      if Result then exit;
      n := length(s) - pl;
      if n < 0 then exit;
      Result := CompareMem(addr(s[n+1]), addr(pattern[1]), pl);
    end;
    2, 3: begin
      Result := length(pattern) = 0;
      if Result then exit;
      Result := pos(pattern, s) > 0;
    end;
    4: Result := mask.Matches(s);
  end;
end;

destructor TForm18.Destroy;
begin
  mask.Free;
  inherited;
end;

end.
